https://connorrothschild.github.io/tidytuesday/2019-10-08/index
#install.packages("ggplot2")
#install.packages("tidyverse")
#install.packages("cr")
#install.packages("flexdashboard")
library(flexdashboard)
library(ggplot2)
library(tidyverse)
library(tidyr)
#library(cr)
#set_cr_theme(font = "lato")
# df <- readr::read_csv("openpowerlifting-2019-09-20.csv")
#
# df_clean <- df %>%
# janitor::clean_names()
#
# ipf_lifts <- df_clean %>%
# select(name:weight_class_kg, starts_with("best"), place, date, federation, meet_name) %>%
# filter(!is.na(date)) %>%
# filter(federation == "IPF")
ipf_lifts <- read_csv("data/ipf_lifts.csv")
## Parsed with column specification:
## cols(
## name = col_character(),
## sex = col_character(),
## event = col_character(),
## equipment = col_character(),
## age = col_double(),
## age_class = col_character(),
## division = col_character(),
## bodyweight_kg = col_double(),
## weight_class_kg = col_character(),
## best3squat_kg = col_double(),
## best3bench_kg = col_double(),
## best3deadlift_kg = col_double(),
## place = col_character(),
## date = col_date(format = ""),
## federation = col_character(),
## meet_name = col_character()
## )
# run the glimpse() function
glimpse(ipf_lifts)
## Observations: 41,152
## Variables: 16
## $ name <chr> "Hiroyuki Isagawa", "David Mannering", "Eddy Pe…
## $ sex <chr> "M", "M", "M", "M", "M", "M", "M", "M", "M", "M…
## $ event <chr> "SBD", "SBD", "SBD", "SBD", "SBD", "SBD", "SBD"…
## $ equipment <chr> "Single-ply", "Single-ply", "Single-ply", "Sing…
## $ age <dbl> NA, 24.0, 35.5, 19.5, NA, NA, 32.5, 31.5, NA, N…
## $ age_class <chr> NA, "24-34", "35-39", "20-23", NA, NA, "24-34",…
## $ division <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
## $ bodyweight_kg <dbl> 67.5, 67.5, 67.5, 67.5, 67.5, 67.5, 67.5, 90.0,…
## $ weight_class_kg <chr> "67.5", "67.5", "67.5", "67.5", "67.5", "67.5",…
## $ best3squat_kg <dbl> 205.0, 225.0, 245.0, 195.0, 240.0, 200.0, 220.0…
## $ best3bench_kg <dbl> 140.0, 132.5, 157.5, 110.0, 140.0, 100.0, 140.0…
## $ best3deadlift_kg <dbl> 225.0, 235.0, 270.0, 240.0, 215.0, 230.0, 235.0…
## $ place <chr> "1", "2", "3", "4", "5", "6", "7", "1", "2", "2…
## $ date <date> 1985-08-03, 1985-08-03, 1985-08-03, 1985-08-03…
## $ federation <chr> "IPF", "IPF", "IPF", "IPF", "IPF", "IPF", "IPF"…
## $ meet_name <chr> "World Games", "World Games", "World Games", "W…
#install.packages("lubridate")
library(lubridate)
##
## Attaching package: 'lubridate'
## The following object is masked from 'package:base':
##
## date
ipf_lifts <- ipf_lifts %>%
mutate(year = lubridate::year(date))
ipf_lifts_reshape <- ipf_lifts %>%
tidyr::pivot_longer(cols = c("best3squat_kg", "best3bench_kg", "best3deadlift_kg"), names_to = "lift") %>%
select(name, sex, year, lift, value)
ipf_lifts_maxes <- ipf_lifts_reshape %>%
group_by(year, sex, lift) %>%
top_n(1, value) %>%
ungroup %>%
distinct(year, lift, value, .keep_all = TRUE)
max_pivot <- ipf_lifts_maxes %>%
spread(sex, value)
male_lifts <- max_pivot %>%
select(-name) %>%
filter(!is.na(M)) %>%
group_by(year, lift) %>%
summarise(male = mean(M))
female_lifts <- max_pivot %>%
select(-name) %>%
filter(!is.na(`F`)) %>%
group_by(year, lift) %>%
summarise(female = mean(`F`))
max_lifts <- merge(male_lifts, female_lifts)
max_lifts_final <- max_lifts %>%
group_by(year, lift) %>%
mutate(diff = male - female)
#install.packages("devtools")
#devtools::install_github("clauswilke/ggtext")
#devtools::install_github("connorrothschild/tpltheme")
library(tpltheme)
##
## Attaching package: 'tpltheme'
## The following objects are masked from 'package:ggplot2':
##
## geom_bar, geom_col, geom_jitter, geom_line, geom_path,
## geom_step, scale_color_continuous, scale_color_discrete,
## scale_color_gradient, scale_color_gradientn,
## scale_colour_discrete, scale_colour_gradient,
## scale_colour_gradientn, scale_colour_ordinal,
## scale_fill_continuous, scale_fill_discrete,
## scale_fill_gradient, scale_fill_gradientn, scale_fill_ordinal
#install.packages("ggalt")
library(ggtext)
max_lifts_final %>%
filter(year == 2019) %>%
ggplot() +
ggalt::geom_dumbbell(aes(y = lift,
x = female, xend = male),
colour = "grey", size = 5,
colour_x = "#D6604C", colour_xend = "#395B74") +
labs(y = element_blank(),
x = "Top Lift Recorded (kg)",
title = "How <span style='color:#D6604C'>Women</span> and <span style='color:#395B74'>Men</span> Differ in Top Lifts",
subtitle = "In 2019") +
theme(plot.title = element_markdown(lineheight = 1.1, size = 20),
plot.subtitle = element_text(size = 15)) +
scale_y_discrete(labels = c("Bench", "Deadlift", "Squat")) +
drop_axis(axis = "y") +
geom_text(aes(x = female, y = lift, label = paste(female, "kg")),
color = "#D6604C", size = 4, vjust = -2) +
geom_text(aes(x = male, y = lift, label = paste(male, "kg")),
color = "#395B74", size = 4, vjust = -2) +
geom_rect(aes(xmin=430, xmax=470, ymin=-Inf, ymax=Inf), fill="grey80") +
geom_text(aes(label=diff, y=lift, x=450), fontface="bold", size=4) +
geom_text(aes(x=450, y=3, label="Difference"),
color="grey20", size=4, vjust=-3, fontface="bold")
## Registered S3 methods overwritten by 'ggalt':
## method from
## grid.draw.absoluteGrob ggplot2
## grobHeight.absoluteGrob ggplot2
## grobWidth.absoluteGrob ggplot2
## grobX.absoluteGrob ggplot2
## grobY.absoluteGrob ggplot2
#Column {data-width=650} #————————————-
#install.packages('gganimate')
#install.packages("gifski")
library(gganimate)
library(gifski)
animation <- max_lifts_final %>%
ggplot() +
ggalt::geom_dumbbell(aes(y = lift,
x = female, xend = male),
colour = "grey", size = 5,
colour_x = "#D6604C", colour_xend = "#395B74") +
labs(y = element_blank(),
x = "Top Lift Recorded (kg)",
title = "How <span style='color:#D6604C'>Women</span> and <span style='color:#395B74'>Men</span> Differ in Top Lifts",
subtitle='\nThis plot depicts the difference between the heaviest lifts for each sex at International Powerlifting Federation\nevents over time. \n \n{closest_state}') +
theme(plot.title = element_markdown(lineheight = 1.1, size = 25, margin=margin(0,0,0,0)),
plot.subtitle = element_text(size = 15, margin=margin(8,0,-30,0))) +
scale_y_discrete(labels = c("Bench", "Deadlift", "Squat")) +
drop_axis(axis = "y") +
geom_text(aes(x = female, y = lift, label = paste(female, "kg")),
color = "#D6604C", size = 4, vjust = -2) +
geom_text(aes(x = male, y = lift, label = paste(male, "kg")),
color = "#395B74", size = 4, vjust = -2) +
transition_states(year, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
a_gif <- animate(animation,
fps = 10,
duration = 25,
width = 800, height = 400,
renderer = gifski_renderer("./heavy_lifts_each_sex.gif"))
a_gif
animation2 <- max_lifts_final %>%
ungroup %>%
mutate(lift = case_when(lift == "best3bench_kg" ~ "Bench",
lift == "best3squat_kg" ~ "Squat",
lift == "best3deadlift_kg" ~ "Deadlift")) %>%
ggplot(aes(year, diff, group = lift, color = lift)) +
geom_line(show.legend = FALSE) +
geom_segment(aes(xend = 2019.1, yend = diff), linetype = 2, colour = 'grey', show.legend = FALSE) +
geom_point(size = 2, show.legend = FALSE) +
geom_text(aes(x = 2019.1, label = lift, color = "#000000"), hjust = 0, show.legend = FALSE) +
drop_axis(axis = "y") +
transition_reveal(year) +
coord_cartesian(clip = 'off') +
theme(plot.title = element_text(size = 20)) +
labs(title = 'Difference over time',
y = 'Difference (kg)',
x = element_blank()) +
theme(plot.margin = margin(5.5, 40, 5.5, 5.5))
b_gif <- animate(animation2,
fps = 10,
duration = 25,
width = 800, height = 200,
renderer = gifski_renderer("./difference_over_time.gif"))
b_gif
#install.packages("magick")
#library(magick)
#a_mgif <- image_read(a_gif)
#b_mgif <- image_read(b_gif)
#new_gif <- image_append(c(a_mgif[1], b_mgif[1]), stack = TRUE)
#for(i in 2:250){
# combined <- image_append(c(a_mgif[i], b_mgif[i]), stack = TRUE)
#new_gif <- c(new_gif, combined)
#}
#new_gif
#install.packages("ggridges")
library(gganimate)
library(gifski)
library(ggridges)
##
## Attaching package: 'ggridges'
## The following object is masked from 'package:ggplot2':
##
## scale_discrete_manual
ipf_lifts_year <- ipf_lifts %>%
mutate(year = format(date, "%Y")) %>%
filter(year %in% c(2009:2019))
ipf_lifts_decade<- ggplot(data=ipf_lifts_year, mapping = aes(x=best3squat_kg, y=year, fill=sex)) +
geom_density_ridges() +
scale_fill_manual(values = colorspace::darken(c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#999999")), labels = c("female", "male")) +
scale_color_manual(values = colorspace::darken(c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#999999"), 0.3))+
labs(x = "Weight (kg)",y = "Year",title = "Squat") +
scale_x_continuous(limits = c(10,500)) + theme_ridges()+ transition_manual(year)
my_gif <- animate(ipf_lifts_decade,
fps = 5,
duration = 10,
width = 800, height = 200,
renderer = gifski_renderer("./ipf_lifts_decade.gif"))
## Picking joint bandwidth of 14.1
## Warning: Removed 7332 rows containing non-finite values
## (stat_density_ridges).
## nframes and fps adjusted to match transition
my_gif